home *** CD-ROM | disk | FTP | other *** search
/ Shareware Super Platinum 8 / Shareware Super Platinum 8.iso / mac / WIN_PRO / DS-1.ZIP;1 / RUNTIME.ZIP / FSCAN.R < prev    next >
Encoding:
Text File  |  1992-02-10  |  2.7 KB  |  145 lines
  1. /*
  2.  * File: fscan.r
  3.  *  Contents: move, pos, tab.
  4.  */
  5.  
  6. "move(i) - move &pos by i, return substring of &subject spanned."
  7. " Reverses effects if resumed."
  8.  
  9. function{0,1+} move(i)
  10.  
  11.    if !cnv:C_integer(i) then
  12.       runerr(101,i)
  13.  
  14.    abstract {
  15.       return string
  16.       }
  17.  
  18.    body {
  19.       register C_integer j;
  20.       C_integer oldpos;
  21.       long l;
  22.  
  23.       /*
  24.        * Save old &pos.  Local variable j holds &pos before the move.
  25.        */
  26.       oldpos = j = k_pos;
  27.  
  28.       /*
  29.        * If attempted move is past either end of the string, fail.
  30.        */
  31.       if (i + j <= 0 || i + j > StrLen(k_subject) + 1)
  32.          fail;
  33.  
  34.       /*
  35.        * Set new &pos.
  36.        */
  37.       k_pos += i;
  38.  
  39.       /*
  40.        * Make sure i >= 0.
  41.        */
  42.       if (i < 0) {
  43.          j += i;
  44.          i = -i;
  45.          }
  46.  
  47.       /*
  48.        * Suspend substring of &subject that was moved over.
  49.        */
  50.       suspend string(i, StrLoc(k_subject) + j - 1);
  51.  
  52.       /*
  53.        * If move is resumed, restore the old position and fail.
  54.        */
  55.       if (oldpos > StrLen(k_subject) + 1)
  56.          runerr(205, kywd_pos);
  57.       else
  58.          k_pos = oldpos;
  59.  
  60.       fail;
  61.       }
  62. end
  63.  
  64.  
  65. "pos(i) - test if &pos is at position i in &subject."
  66.  
  67. function{0,1} pos(i)
  68.  
  69.    if !cnv:C_integer(i) then
  70.       runerr(101, i)
  71.  
  72.    abstract {
  73.       return integer
  74.       }
  75.    body {
  76.       /*
  77.        * Fail if &pos is not equivalent to i, return i otherwise.
  78.        */
  79.       if ((i = cvpos(i, StrLen(k_subject))) != k_pos)
  80.          fail;
  81.       return C_integer i;
  82.       }
  83. end
  84.  
  85.  
  86. "tab(i) - set &pos to i, return substring of &subject spanned."
  87. "Reverses effects if resumed."
  88.  
  89. function{0,1+} tab(i)
  90.  
  91.    if !cnv:C_integer(i) then
  92.       runerr(101, i);
  93.  
  94.    abstract {
  95.       return string
  96.       }
  97.  
  98.    body {
  99.       C_integer j, t, oldpos;
  100.  
  101.       /*
  102.        * Convert i to an absolute position.
  103.        */
  104.       i = cvpos(i, StrLen(k_subject));
  105.       if (i == CvtFail)
  106.          fail;
  107.  
  108.       /*
  109.        * Save old &pos.  Local variable j holds &pos before the tab.
  110.        */
  111.       oldpos = j = k_pos;
  112.  
  113.       /*
  114.        * Set new &pos.
  115.        */
  116.       k_pos = i;
  117.  
  118.       /*
  119.        *  Make i the length of the substring &subject[i:j]
  120.        */
  121.       if (j > i) {
  122.          t = j;
  123.          j = i;
  124.          i = t - j;
  125.          }
  126.       else
  127.          i = i - j;
  128.  
  129.       /*
  130.        * Suspend the portion of &subject that was tabbed over.
  131.        */
  132.       suspend string(i, StrLoc(k_subject) + j - 1);
  133.  
  134.       /*
  135.        * If tab is resumed, restore the old position and fail.
  136.        */
  137.       if (oldpos > StrLen(k_subject) + 1)
  138.          runerr(205, kywd_pos);
  139.       else
  140.          k_pos = oldpos;
  141.  
  142.       fail;
  143.       }
  144. end
  145.